perm filename RESPC.F4[PAG,LCS]3 blob sn#371516 filedate 1978-08-04 generic text, type T, neo UTF8
00100		SUBROUTINE RESPC
00200		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400		1 RCLEF(0/7) /IVV/IV(1)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700		COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800		1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900	C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000	      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100		1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200		INTEGER DUMMY
01300		COMMON /PX/PN(1) /Q/Q(1)
01400		1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500		1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01600		DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700		1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800	C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000		1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200		1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300		1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400		1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
02600	CC	DATA JXYZ/1/
02700	
02800		IF(NMPG.NE.'PAGEA')GO TO 2000
02900	CC	NPZ='PAGEZ'
03000	CC	NPZF='PAGFZ'
03100	CC	NPZG='PAGGZ'
03200	C SHOULD HANDLE UP TO 104 INPUT FILES.  ADD HERE AND LATER FOR MORE RANGE.
03300		RNEXT=0
03400	2000	SPCNT=1.0
03500	CC	DO 2001 K=1,JXYZ
03600	CC2001	RN(K)=0
03700	C MUST ZERO NN AND MM ARRAYS, ETC.
03800		JX=0
03900		JCEN=0
04000	C  FLAG FOR CENTERED RESTS.
04100		XT=0
04200		PX=0
04300		CALL SHFT1(KQ)
04400		KK=L
04500	CC	TYPE 3001,L
04600	C  DELETES EXTRA BAR LINES, ETC.
04700		IF(IPG)CALL RESTS
04800	C???	IF(N)RETURN 
04900	C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
05000	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
05100		CALL SHIFT
05200	C  L=NUMBER OF ITEMS FOR RHY RECONS.
05300		JJ2=L+2
05400	C FOR WDCNT IN .PAG FILE
05500		N=0
05600		S=-100
05700		R=0
05800		KCLEF=0
05900		NOGRCE=-1
06000	C  GRACE NOTE FLAG
06100		TTT=0
06200	C FOR IRREG. NUMS. OF STAVES.
06300	
06400	CC	DO 61 K=1,L
06500	CC	R=CODEN(KPN,K,Q,J)
06600	CC	IF(R.GT.2)GO TO 61
06700	C NOW FOUND FIRST ITEM TO LEFT (NOTE OR REST, THAT IS.)
06800	CC	IF(K.EQ.1)GO TO 161
06900	C JUMP OUT IF NOTHING BEFORE NOTE OR REST
07000	CC	A=Q(J+3)+.5
07100	C GET POSITION OF NOTE OR REST
07200	CC	DO 261 M=1,K-1
07300	CC	R=CODEN(KPN,M,Q,J)
07400	CC	IF(R.LT.9)GO TO 261
07500	CC	IF(R.LT.17)Q(J+3)=A
07600	CC261	CONTINUE
07700	C MOVE ITEM TO RIGHT, .5 PAST NOTE OR REST
07800	CC	GO TO 161
07900	CC61	CONTINUE
08000	
08100	161	DO 601 K=1,L
08200		R=CODEN(KPN,K,Q,J)
08300		RZ=Q(J)
08400	CX	J=KPN(K)
08500	CC	N=N+1
08600	CC	NN(N)=0
08700	CC	MM(N)=J+3
08800		CALL MMNN(3)
08900	CX	R=Q(J+1)
09000		IF(R.GT.2)GO TO 1801
09100		IF(Q(J+2).GT.TTT)TTT=Q(J+2)
09200	C FINDS HIGHEST STAFF NUM.  NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
09300		IF(R.NE.1)GO TO 2801
09400		IF(RZ.LT.7)GO TO 601
09500		IF(Q(J+9).GT..05)GO TO 702
09600		IF(Q(J+9).EQ.0)GO TO 601
09700	CC	IF(Q(J+8).EQ.1000)GO TO 601
09800	C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
09900		NOGRCE=0
10000		GO TO 601
10100	CCC2801	IF(R.NE.2)GO TO 1801
10200	2801	IF(RZ.NE.7)GO TO 3801
10300	C DELETE ALL UP TO LABEL 1801 LATER.  NEW CENTERED REST FEATURE. 5/29/78
10400		NN(N)=R
10500		GO TO 688
10600	3801	IF(RZ.LT.5)GO TO 601
10700		IF(IPG)GO TO 1801
10800		IF(RZ.LT.6)GO TO 1801
10900		RS=Q(J+3)
11000	C GET POS. OF CENTERED WHOLE REST
11100		TT=0
11200		B=Q(J+2)
11300	C GET THE STAFF NUM.
11400		DO 602 M=1,L
11500		T=CODEN(KPN,M,Q,JJ)
11600		A=Q(JJ+3)
11700	C GET POS. OF ITEM
11800		IF(A.GT.RS)GO TO 602
11900	C JUMP IF ITEM IS TO RIGHT OF REST
12000		IF(T.NE.4)GO TO 602
12100	C IS THE ITEM A BAR LINE
12200		IF(A.GT.TT)TT=A
12300	C FINDS BAR LINE CLOSEST TO LEFT OF REST
12400	602	CONTINUE
12500	C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
12600		T=20000
12700		A=20000
12800	C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
12900		DO 613 M=1,L
13000		IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
13100		IF(Q(JJ).LT.7)GO TO 609
13200	C SKIP IF RHYTH NOT IN P9
13300		IF(Q(JJ+9).LT..05)GO TO 613
13400	C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
13500	609	B=Q(JJ+3)
13600	C POS. OF ITEM
13700		X=B-TT
13800		IF(X)GO TO 613
13900	C JUMP IF ITEM IS TOO FAR TO LEFT
14000		IF(X.GT.A)GO TO 613
14100		A=X
14200		T=B
14300	C T = POS OF NOTE OR REST NEAREST BAR, ETC.
14400	613	CONTINUE
14500		IF(T.NE.20000)GO TO 612
14600	C JUMP IF NOTE OR REST FOUND
14700		JCEN=-1
14800		GO TO 1801
14900	612	Q(J+3)=T
15000	C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
15100	C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
15200	C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
15300	1801	IF(R.LT.4)GO TO 702
15400		IF(R.EQ.17)GO TO 1702
15500		IF(R.EQ.18)GO TO 1702
15550		IF(R.EQ.10)GO TO 702
15575	C FOUND A NUMBER.  USE THIS IN RESTP
15600		IF(R.LE.7)GO TO 30
15700		IF(R.NE.44)GO TO 601
15800		IF(RZ.EQ.2)GO TO 601
15900	C RZ=2= BAR LINE ON UPPER STAFF
16000		IF(Q(J+6).EQ.0)GO TO 601
16100		IF(Q(J+5).EQ.0)GO TO 601
16200	C  GETS LEFT END OF LINES, CRESC., DASHES.
16300		GO TO 604
16400	30	IF(R.NE.7)GO TO 605
16500		IF(RZ.LT.5)GO TO 604
16600	C JUMP FOR STANDARD TRILL
16700		RS=Q(J+7)
16800		IF(RS.EQ.1)GO TO 604
16900		IF(ABS(RS).GE.3)GO TO 604
17000	C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
17100		GO TO 601
17200	605	IF(R.NE.4)GO TO 604
17300		IF(RZ.LE.3)GO TO 702
17400	C JUMP IF IT IS A BAR LINE
17500	CC	IF(RZ.LT.4)GO TO 601
17600		IF(Q(J+6).NE.0)GO TO 604
17700	C GO GET OTHER POS OF LINE
17800		GO TO 601
17900	1702	IF(Q(J+4).NE.0)GO TO 601
18000		IF(Q(J+2).NE.0)GO TO 601
18100	C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
18200	702	NN(N)=R 
18300		GO TO 601
18400	C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
18500	604	CALL MMNN(6)
18600	C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
18700		IF(R.NE.6)GO TO 601
18800	C NEXT FOR BEAMS
18900		IF(RZ.LT.8)GO TO 608
19000		IF(Q(J+10).EQ.0)GO TO 608
19100		IF(Q(J+8))GO TO 608
19200	C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
19300		IF(Q(J+7).GT.0)CALL MMNN(8)
19400	C NEXT SHIFTS P8 OF COMPOSITE BEAMS
19500	608	IF(RZ.LT.7)GO TO 601
19600		IF(Q(J+7))GO TO 688
19700	C  P7 IS NEG FOR TREMOLO
19800		IF(Q(J+8).EQ.0)GO TO 601
19900	C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
20000	688	IF(Q(J+9).GT.0)CALL MMNN(9)
20100	C FOUND A POS. IN P9
20200	601	CONTINUE
20300		KPG=TTT+1
20400	C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
20500	
20600	C NEXT SORTS THE POINTS
20700	6000	J=1
20800	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
20900		CALL EXCHG(MM(J),NN(J))
21000	C  ABOVE EXCHGS --(J) AND --(J+1)
21100		IF(J.EQ.1)GO TO 710
21200		J=J-1
21300		GO TO 610
21400	710	J=J+1
21500		IF(J.LT.N)GO TO 610
21600	C NOW ALL SORTED
21700		CALL FNDEND(R)
21800		CALL SHFTQ(R)
21900	C  SHIFTS TO PROPER HORIZ. POS.
22000		IF(IPG)CALL RESTP
22100	C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
22200		IF(N.LE.0)GO TO 122
22300	C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.
22400	
22500		DO 119 K=1,150
22600	119	HH(K)=0
22700	C  HH ARRAY WILL HOLD FINAL COMPOSITE.
22800		G(1)=0
22900		E(1)=0
23000		F(1)=0
23100		RN(1500)=0
23200		RN(2500)=0
23300		ST=0
23400	C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
23500	C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
23600		KE=0
23700		J=1000
23800	933	JJ=1500
23900		JJJ=2000
24000		T=0
24100		M=0
24200		A=0
24300		B=0
24400	
24500		DO 33 K=1,N
24600		IF(NORH(KK))GO TO 33
24700	CC	KK=NN(K)
24800	CC	IF(KK.EQ.0)GO TO 33
24900	CC	IF(KK.EQ.4)GO TO 2133
25000	CC	IF(KK.EQ.17)GO TO 2133
25100	C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
25200	CC	IF(KK.EQ.18)GO TO 2133
25300	CC	IF(KK.GT.2)GO TO 33
25400	2133	LL=MM(K)-3
25500		IF(KK.LE.2)GO TO 1133
25600		RH=.01
25700	C RHYTHMIC VALUE OF BARLINE, METER, KSIG
25800	CCC	IF(KK.NE.4)RH=.6
25900		GO TO 3133
26000	1133	IF(Q(LL+2).NE.ST)GO TO 33
26100	C JUMP IF NOT ON RIGHT STAFF
26200		RA=9
26300		IF(KK.EQ.2)RA=7
26400		IF(Q(LL).LT.RA-2)GO TO 33
26500	C JUMP IF WDCNT IS TOO SHORT
26600		IF(KK.EQ.1)GO TO 433
26700		IF(Q(LL).LT.6)GO TO 433
26800	C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
26900		RZ=Q(LL+8)
27000	C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
27100		IF(RZ.LE.0)GO TO 433
27200		Q(LL+7)=3
27300	C 3 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST
27400		IF(RZ.LT.8)GO TO 433
27500		Q(LL+5)=-3
27600	C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
27700		RZ=IFIX(RZ/2.0)+1.0
27800		IF(RZ.GT.6)RZ=6
27900	C LIMIT OF 8 ON RHYTH VAL.
28000		Q(LL+7)=RZ
28100	433	RH=Q(LL+IFIX(RA))
28200		IF(RH.EQ.0)GO TO 33
28300	3133	RZ=Q(LL+3)
28400		IF(ZERO(RZ,A).EQ.0)GO TO 133
28500	C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
28600		RRH=RH
28700	C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
28800		TT=T
28900	C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
29000		J=J+1
29100	C UPDATE COUNTER IN POSITION ARRAY
29200		T=T+RH
29300	C ADD TO TOTAL RHYTHM
29400		RN(J)=T
29500		A=Q(LL+3)
29600	C SAVE POS. OF THIS NOTE.
29700		GO TO 33
29800	133	IF(RH.EQ.RHH)GO TO 33
29900	C  IGNORE 2ND RHYTH IF SAME AS FIRST
30000		IF(ZERO(RZ,B).EQ.0)GO TO 333
30100	C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
30200		TTT=TT
30300	C SAVE TOTAL RHYTHM TO THIS POINT.
30400		TT=TT+RH
30500		JJ=JJ+1
30600	C UPDATE COUNTER FOR 2ND ARRAY
30700		RN(JJ)=TT
30800		RRRH=RH
30900		B=A
31000		GO TO 33
31100	333	IF(RH.EQ.RRRH)GO TO 33
31200		TTT=TTT+RH
31300		JJJ=JJJ+1
31400		RN(JJJ)=TTT
31500	33	CONTINUE
31600	C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
31700		IF(ST.NE.0)GO TO 733
31800		KE=J-999
31900	C TOTAL NUM OF RHYTHMS ON STAFF1.
32000	CC	IF(JPG.EQ.0)GO TO 2233
32100		IF(KPG.LE.1)GO TO 2233
32200	C KPG=0=PARTS;    =1=PAGE, 1 STAFF
32300	C  JUMP IF ONLY ONE STAFF
32400	C****733	KF=J-2499
32500	C KF=NUM OF RHYTHMS ON NEXT STAFF.  **** NEVER USED ****
32600	733	ST=ST+1
32700		IF(ST.GT.1)GO TO 833
32800	C JUMP IF ALL STAVES HAVE BEEN READ.
32900	1233	J=2500
33000		GO TO 933
33100	833	IF(J.NE.2500)GO TO 1533
33200	C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
33300	C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
33400	
33500	2233	CALL RLOOP(HH,E,KE)
33600	C FOR SINGLE STAFF OF RHYTHM
33700		KL=KE
33800		GO TO 1333
33900	1533	K=1
34000		L=1
34100		M=0
34200	19	KK=K
34300		LL=L
34400	1	SM=10000
34500		K=K+1
34600		IF(K.GT.KE)GO TO 10
34700	4	L=L+1
34800		Y=F(L)
34900		B=Y-F(L-1)
35000		IF(B.LT.SM)SM=B
35100	2	X=E(K)
35200		A=X-E(K-1)
35300	C  A AND B HAVE TRUE DURATIONS NOW
35400		IF(A.LT.SM)SM=A
35500	C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
35600		IF(ZERO(X,Y).EQ.0)GO TO 3
35700	C JUMP IF EQUAL RHYTHS
35800		IF(X.GT.Y)GO TO 4
35900		K=K+1
36000	C STEP FORWARD UNTIL X IS .GT. Y
36100		GO TO 2
36200	3	IF(K.NE.KK+1)GO TO 13
36300		IF(L.NE.LL+1)GO TO 14
36400		M=M+1
36500		G(M)=E(KK)
36600		GO TO 19
36700	13	IF(L.NE.LL+1)GO TO 15
36800		DO 16 J=KK,K-1
36900		M=M+1
37000	16	G(M)=E(J)
37100		GO TO 19
37200	14	DO 17 J=LL,L-1
37300		M=M+1
37400	17	G(M)=F(J)
37500		GO TO 19
37600	15	XM=SM-.001
37700		M=M+1
37800		P=E(KK)
37900		G(M)=P
38000	7	KK=KK+1
38100		LL=LL+1
38200		YM=SM*1.5
38300	C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
38400		S=P
38500		T=P
38600	27	A=E(KK)
38700		B=F(LL)
38800		IF(ZERO(A,B).EQ.0)GO TO 19
38900		X=ZERO(A,P)
39000		Y=ZERO(B,P)
39100	C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
39200		S=E(KK-1)
39300		T=F(LL-1)
39400	9	IF(A-S.LT.X-.01)X=ZERO(A,S)
39500		IF(B-T.LT.Y-.01)Y=ZERO(B,T)
39600		IF(A.GT.B+.01)GO TO 8
39700		B=A
39800		KK=KK+1
39900	62	IF(X.GT.YM)GO TO 5
40000		IF(X.EQ.0)GO TO 27
40100		P=P+SM
40200	25	M=M+1
40300		G(M)=P
40400		GO TO 27
40500	5	P=P+SM
40600		IF(P)GO TO 203
40700	C IF(P)ERROR
40800		IF(P.LT.B-.01)GO TO 5
40900		GO TO 25
41000	8	X=Y
41100		LL=LL+1
41200		GO TO 62
41300	10	M=M+1
41400		G(M)=E(KE)
41500	CC	TYPE 410,(E(K),K=1,KE)
41600	CC	TYPE 410,(F(K),K=1,KF)
41700	CC	TYPE 410,(G(K),K=1,M)
41800	CBCB	WRITE(21,410)(E(K),K=1,KE)
41900	CB	WRITE(21,410)(F(K),K=1,KF)
42000	CB	WRITE(21,410)(G(K),K=1,M)
42100	410	FORMAT(10F7.2)
42200	C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
42300	1033	JJ=1
42400		H(1)=0
42500		J=1
42600		K=2
42700		L=2
42800	511	IF(J.EQ.M)GO TO 911
42900		J=J+1
43000		X=G(J)
43100	1211	A=E(K)
43200		B=F(L)
43300		Y=ZERO(X,A)
43400		Z=ZERO(X,B)
43500		IF(A-B.GT..01)GO TO 1111
43600		IF(Y.EQ.0)GO TO 1311
43700		IF(X.LT.A-.01)GO TO 1111
43800		K=K+1
43900	1411	JJ=JJ+1
44000		H(JJ)=-A
44100		GO TO 1211
44200	1111	IF(Z.EQ.0)GO TO 1311
44300		IF(X.LT.B-.01)GO TO 1311
44400		L=L+1
44500		A=B
44600		GO TO 1411
44700	
44800	1311	JJ=JJ+1
44900		H(JJ)=X
45000		IF(Y.EQ.0)GO TO 611
45100		IF(Z.EQ.0)GO TO 711
45200		IF(ZERO(A,B).EQ.0)GO TO 511
45300		P=A
45400		IF(P.GT.B+.01)GO TO 811
45500		IF(P.GT.X+.01)GO TO 511
45600		K=K+1
45700		GO TO 1011
45800	811	P=B
45900		IF(P.GT.X+.01)GO TO 511
46000		L=L+1
46100	1011	JJ=JJ+1
46200		H(JJ)=-P
46300	C NON-SPACED RHYTHS ARE NEG.
46400		GO TO 511
46500	611	K=K+1
46600		IF(Z.GT.0)GO TO 511
46700	711	L=L+1
46800		GO TO 511
46900	911	IF(HH(2).EQ.0)GO TO 2011
47000		K=2
47100		J=2
47200		L=1
47300		HHH(1)=0
47400	1511	IF(J.GT.JJ)GO TO 1811
47500		P=H(J)
47600		A=ABS(P)
47700		B=ABS(HH(K))
47800		IF(ZERO(B,A).EQ.0)GO TO 1611
47900		IF(A.GT.B)GO TO 1711
48000		J=J+1
48100		GO TO 1911
48200	1711	P=HH(K)
48300		GO TO 2211
48400	1611	J=J+1
48500	2211	K=K+1
48600	1911	L=L+1
48700		HHH(L)=P
48800		GO TO 1511
48900	2011	CALL RLOOP(HH,H,JJ)
49000		KL=JJ
49100		GO TO 2111
49200	1811	CALL RLOOP(HH,HHH,L)
49300		KL=L
49400	2111	IF(ST.GE.KPG)GO TO 1333
49500		CALL RLOOP(E,G,M)
49600		KE=M
49700	C GO WAY BACK AND READ ANOTHER LINE.
49800		GO TO 1233
49900	1333	E(1)=0
50000		GO TO 2333
50100		TYPE 410,(HH(K),K=1,KL)
50200		WRITE(21,410)(HH(K),K=1,KL)
50300	2333	JD=1
50400	C JD IS COUNTER FOR DUMMY POSITIONS.
50500		DUMMY(1)=1
50600		ST=0
50700	183	B=0
50800		LL=2
50900	
51000		DO 181 K=1,N
51100		IF(NORH(L))GO TO 181
51200	C LOOK FOR DUMMY RHYTHMS.
51300		IF(L.LE.2)GO TO 2184
51400		RZ=.01
51500	C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
51600		GO TO 1184
51700	2184	LF=MM(K)
51800		IF(Q(LF-1).NE.ST)GO TO 181
51900	C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
52000		J=6
52100		IF(L.EQ.2)J=4
52200		RZ=Q(LF+J)
52300	1184	B=B+RZ
52400	184	V=ABS(HH(LL))
52500		IF(ZERO(B,V).GT.0)GO TO 182
52600	C FOUND RHYTH MATCH
52700		JD=JD+1
52800		DUMMY(JD)=LL
52900		LL=LL+1
53000		GO TO 181
53100	182	IF(B.LT.V-.01)GO TO 181
53200		LL=LL+1
53300		GO TO 184
53400	181	CONTINUE
53500		ST=ST+1
53600		IF(ST.LT.KPG)GO TO 183
53700	
53800	C NEXT SORT DUMMY ARRAY
53900		J=0
54000	185	DO 186 K=2,JD
54100		IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
54200		DO 188 LL=K,JD
54300	188	DUMMY(LL-1)=DUMMY(LL)
54400		JD=JD-1
54500		GO TO 185
54600	187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
54700		CALL EXCH(DUMMY(K),DUMMY(K-1))
54800		GO TO 185
54900	186	CONTINUE
55000	C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
55100		PX=0
55200		LF=0
55300		K=1
55400		V=0
55500	
55600	81	K=K+1
55700		IF(K.GT.KL)GO TO 1433
55800		B=HH(K)
55900		A=B-V
56000		V=B
56100		IF(V)GO TO 82
56200	85	W=V
56300		IF(A.GT.0.01)GO TO 89
56400	C  .GT. BECAUSE OF ROUND-OFF ERROR
56500		T=5
56600		IF(HH(K+1)-V.LE..01)T=2
56700		PX=PX+T
56800	C THIS FOR BARS, KSIG, METER
56900		GO TO 189
57000	89	PX=PX+14.0*EXP(ALOG(A)*0.5849624)
57100	C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
57200	CC89	PX=PX+PFIBX(A)
57300	189	E(K)=PX
57400		IF(LF.NE.0)GO TO 86
57500		GO TO 81
57600	82	LF=K
57700	83	K=K+1
57800		V=HH(K)
57900		IF(V)GO TO 83
58000		A=V-W
58100		GO TO 85
58200	86	LL=LF-1
58300		D=E(K)-E(LL)
58400	87	S=-HH(LF)-HH(LL)
58500		T=HH(K)-HH(LL)
58600		T=S/T
58700	C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
58800		E(LF)=E(LL)+D*T
58900		LF=LF+1
59000		IF(LF.NE.K)GO TO 87
59100		LF=0
59200		GO TO 81
59300	
59400	1433	GO TO 2433
59500		TYPE 410,(E(K),K=1,KL)
59600		WRITE(21,410)(E(K),K=1,KL)
59700	C  5 IS SPACE AFTER 1ST BARLINE
59800	2433	R8=RNEXT
59900	C POS OF 1ST BAR = END OF PREV. LINE
60000	     	IF(ENDLN.EQ.0)RNEXT=9
60100	C  MAKES ROOM FOR 1ST CLEF.
60200		KL=KL-1
60300		J=0
60400		R5=0
60500		KK=1
60600		JD=1
60700		W=0
60800		LF=0
60900	
61000		DO 80 K=1,N
61100		IF(NORH(L))GO TO 80
61200		A=Q(MM(K))
61300		IF(ZERO(A,W).EQ.0)GO TO 80
61400	C  SKIP IF SAME POS OF NOTE OR REST.
61500		W=A
61600		R7=R8
61700	190	J=J+1
61800		IF(J.LE.KL)GO TO 290
61900	203	FORMAT(' FOUND CENTERED WHOLE REST!')
62000		LL=0
62100		IF(JCEN.GE.0)GO TO 120
62200		TYPE 203
62300		GO TO 121
62400	120	W=LL
62500		A=0
62600		DO 124 K=1,N
62700		LF=NN(K)
62800		IF(LF.GT.2)GO TO 124
62900		IF(LF.EQ.0)GO TO 124
63000		KE=MM(K)
63100		IF(Q(KE-1).NE.W)GO TO 124
63200	C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
63300		JD=6
63400		IF(LF.EQ.2)JD=4
63500		A=A+Q(KE+JD)
63600	124	CONTINUE
63700		TYPE 123,LL,A
63800		LL=LL+1
63900		IF(LL.LT.KPG)GO TO 120
64000	123	FORMAT(' STF',I2,' =',F9.5,' QTRS')
64100	121	PAUSE' *****RHYTHM MISMATCH OR MISALIGNED NOTES*****'
64200		GO TO 90
64300	290	IF(DUMMY(JD).NE.J)GO TO 190
64400		JD=JD+1
64500	90 	R8=RNEXT+E(J)
64600		R4=R5
64700		R5=A
64800		X=(R8-R7)/(R5-R4)
64900		S=R7-R4*X
65000		DO 91 L=KK,K
65100		LL=MM(L)
65200	91	Q(LL)=S+X*Q(LL)
65300		KK=K+1
65400	80	CONTINUE
65500	
65600		IF(KK.GT.K)GO TO 180
65700	C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
65800		R7=Q(LL)-R5
65900	C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
66000		DO 280 L=KK,K
66100		LL=MM(L)
66200	280	Q(LL)=R7+Q(LL)
66300	180	JJ=JJ2-2
66400		L=JJ2
66500		M=0
66600	C FLAG FOR REST AT START OF LINE
66700	
66800		JJJ=-1
66900	C FLAG FOR 1ST BAR OF LINE 12/77
67000		V=0
67100		ACCI=0
67200		DO 12 J=1,JJ
67300		   R=CODEN(KPN,J,Q,LA)
67400	CC	   IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
67500		   IF(R.EQ.4)GO TO 680
67600		   IF(M)GO TO 780
67700		   IF(R.NE.2)GO TO 780
67800		   IF(KBR.EQ.0)GO TO 12
67900	C  LOOK FOR RESTS AT FRONT OF LINE.
68000		   X=0
68100		   CALL TURN(J,JJ,1,X)
68200		   PGTRN(KBR)=PGTRN(KBR)+X
68300		   M=-1
68400	780	   IF(R.NE.1)GO TO 12
68500		IF(V.NE.Q(LA+3))GO TO 782
68600		IF(JACC)GO TO 781
68700	782	IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
68800		JACC=-1
68900		ACCI=ACCI+.5
69000		V=Q(LA+3)
69100	781	   M=-1
69200		   IF(NOGRCE)GO TO 12
69300	C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
69400	C FOUND A NOTE
69500		   IF(Q(LA+9).GT.0.05)GO TO 12 
69600	C JUMP IF NOT A GRACE NOTE
69700		   R=Q(LA+2)
69800	C  THE STAFF NUM.
69900		   DO 580 LF=J+1,JJ
70000		   	IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
70100			IF(Q(JD+2).NE.R)GO TO 580
70200		   	IF(Q(JD).LT.7)GO TO 580
70300		   	IF(Q(JD+9).EQ.0)GO TO 580
70400	C   CHORD NOTE
70500	  	   	R4=Q(LA+3) 
70600	CC	   	R4=Q(LA+3)-1 
70700		   	R5=Q(JD+3)
70800	C  THE STAFF # IS IN R2
70900		   	R8=RSTFAC(IFIX(R2+1))+.5
71000		   	IF(Q(JD+4).LT.80)R8=R8*2  
71100	C  INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
71200		   	R8=R5-R8
71300	CC	   	R8=R5-R8-1
71400	CCC	   	IF(R4.EQ.R5)GO TO 12
71500		   	IF(R4.NE.R5)GO TO 480
71600	C  GRACE NOTE AT START OF LINE ***** FIX THIS????
71700			DO 880 KE=1,LF-1
71800	880		Q(KPN(KE)+3)=R8
71900	C  MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
72000		   	GO TO 12
72100	480	   	R2=Q(LA+2)
72200		   	R9=R5
72300		   	CALL PTMOVE(Q,KPN)
72400	CC	   	TYPE 9999,Q(J+3),Q(JD+3)
72500	CC9999	   	FORMAT(2F)
72600		   	GO TO 12 
72700	580	   CONTINUE
72800		   GO TO 12
72900	C  ABOVE FOR GRACE NOTE SPACING.
73000	680	   KBR=KBR+1
73100	C BAR LINE COUNTER
73200		   T=Q(LA+3)
73300	C TOTAL SPACE
73400		   X=0
73500		   CALL TURN(J-1,1,-1,X)
73600		   CALL TURN(J+1,JJ,1,X)
73700	222	   PGTRN(KBR)=X
73800	C FINDS PAGE-TURN POSSIBILITIES
73900	C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
74000		   IF(JJJ)RNEXT=RNEXT-6
74100	C JJJ=-1 IF 1ST BAR OF LINE. 12/77
74200		   JJJ=0
74300		   BARS(KBR)=(T-RNEXT+ACCI)*BFAC
74400	C SIZE OF THIS MEASURE + .5*ACCIDENTALS
74500		ACCI=0
74600		   K=J
74700		   RNEXT=T
74800	12	CONTINUE
74900	
75000		IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
75100		RNEXT=RNEXT+3
75200		JJ2=L 
75300	C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
75400	CC???380	LCNT=0
75500	CC???	NDPY=0
75600	C JJ2 IS END OF PNTR DATA
75700		JPQ=KPN(JJ2-1)+1
75800		CALL PUTEXT(NMPG,'PAG')
75900		CALL EXTOUT(RSTFAC,128)
76000		CALL EXTOUT(PN,JJ2)
76100		CALL EXTOUT(Q,JPQ)
76200		CALL FINEXT
76300	
76400		LASTNM=NMPG
76500		NMPG=NMPG+2
76600		IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
76700	C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
76800		IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
76900		IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
77000	122	ENDLN=RNEXT
77100		END